home *** CD-ROM | disk | FTP | other *** search
/ MacGames Sampler / PHT MacGames Bundle.iso / MacSource Folder / Samples from the CD / Editors / emacs / Emacs-1.14b1 / lisp / emacs-19.el < prev    next >
Encoding:
Text File  |  1993-12-29  |  8.4 KB  |  224 lines  |  [TEXT/EMAC]
  1. ;;;; Emacs 19 compatibility functions for use in Emacs 18.
  2. ;;;; $Id: emacs-19.el,v 1.26 1992/04/22 17:02:50 sk RelBeta $
  3.  
  4. ;; These functions are used in dired.el, but are also of general
  5. ;; interest, so you may want to add this to your .emcas:
  6. ;; 
  7. ;; (autoload 'make-directory "emacs-19" "Make a directory." t)
  8. ;; (autoload 'remove-directory "emacs-19" "Remove a directory." t)
  9. ;; (autoload 'diff "emacs-19" "Diff two files." t)
  10. ;; (autoload 'member "emacs-19" "Like memq, but uses `equal' instead of `eq'.")
  11. ;; (autoload 'compiled-function-p "emacs-19" "Emacs 18 doesn't have these.")
  12. ;; (autoload 'comint::background "emacs-19" "Run a COMMAND in the background, like csh." t)
  13. ;; We need these functions in function diff:
  14. (autoload 'shell-quote "dired")        ; actually belongs into simple.el
  15. (autoload 'latest-backup-file "dired")    ; actually belongs into files.el
  16.  
  17. ;; call-process below may lose if filename starts with a `-', but I
  18. ;; fear not all mkdir or rmdir implementations understand `--'.
  19. (defun remove-directory (fn)
  20.   "Remove a directory.
  21. This is a subr in Emacs 19."
  22.   (interactive 
  23.    (list (read-file-name "Remove directory: " nil nil 'confirm)))
  24.   (setq fn (expand-file-name fn))
  25.   (if (file-directory-p fn)
  26.       (call-process "rmdir" nil nil nil fn)
  27.     (error "Not a directory: %s" fn))
  28.   (if (file-exists-p fn)
  29.       (error "Could not remove directory %s" fn)))
  30.  
  31. (defun make-directory (fn)
  32.   "Make a directory.
  33. This is a subr in Emacs 19."
  34.   (interactive (list (read-file-name "Make directory: ")))
  35.   (setq fn (directory-file-name (expand-file-name fn)))
  36.   (if (file-exists-p fn)
  37.       (error "Cannot make directory %s: file already exists" fn)
  38.     (call-process "mkdir" nil nil nil fn))
  39.   (or (file-directory-p fn)
  40.       (error "Could not make directory %s" fn)))
  41.  
  42. ;; variable so that rcs-diff or whatever can let-bind it.
  43. ;; diff would then have to provide a way to insert into a given buffer (?)
  44. ;; and run synchronously (?)
  45. (defvar diff-program "diff"
  46.   "*Program used for function diff (which see).")
  47.  
  48. (defvar diff-switches nil
  49.   "*If non-nil, a string specifying switches to be be passed to diff.
  50. A list of strings (or nil) means that the commandline can be edited
  51. after inserting the strings in the list.") 
  52.  
  53. (defun diff (fn1 fn2 &optional switches)
  54.   "Diff two files FN1 and FN2.
  55. With a prefix arg, you are prompted for the optional third arg
  56.   SWITCHES, the diff switches used.
  57. See also variable diff-switches."
  58.   (interactive (diff-read-args "Diff: " "Diff %s with: "
  59.                    "Diff with switches: "))
  60.   (or (and (stringp fn1)
  61.        (stringp fn2))
  62.       (error  "diff: arguments must be strings: %s %s" fn1 fn2))
  63.   (or switches
  64.       (setq switches (if (stringp diff-switches)
  65.                    diff-switches
  66.                 (if (listp diff-switches)
  67.                 (mapconcat 'identity diff-switches " ")
  68.                   ""))))
  69.   (let ((command (concat diff-program " " switches
  70.              " "
  71.              (shell-quote (expand-file-name fn1))
  72.              " "
  73.              (shell-quote (expand-file-name fn2)))))
  74.     (require 'compile)
  75.     (compile1 command "No more diff's" "diff")))
  76.  
  77. (defun diff-backup (file &optional switches)
  78.   "Diff FILE with its backup file.
  79. Uses the latest backup, if there are several numerical backups.
  80. If FILE is a backup, diff it with its original.
  81. With a prefix arg, you are prompted for the optional third arg
  82.   SWITCHES, the diff switches used.
  83. The backup file is the first file given to `diff'.
  84. See the command `diff'."
  85.   (interactive
  86.    (diff-read-args "Backup Diff: " nil "Switches for Backup Diff: "))
  87.   (let (bak ori)
  88.     (if (backup-file-name-p file)
  89.     (setq bak file
  90.           ori (file-name-sans-versions file))
  91.       (setq bak (or (latest-backup-file file)
  92.             (error "File has no backup: %s" file))
  93.         ori file))
  94.     (diff bak ori switches)))
  95.  
  96. (defun diff-read-args (msg1 msg2 msg3)
  97.   (let* ((fn1 (read-file-name msg1))
  98.      (fn2 (and msg2 (read-file-name (format msg2 fn1))))
  99.      (switches (diff-read-switches msg3)))
  100.     (if msg2
  101.     (list fn1 fn2 switches)
  102.       (list fn1 switches))))
  103.  
  104. (defun diff-read-switches (msg3)
  105.   (if (or current-prefix-arg
  106.       (listp diff-switches))
  107.       (read-string msg3
  108.            (if (stringp diff-switches)
  109.                diff-switches
  110.              (if (listp diff-switches)
  111.              (mapconcat 'identity
  112.                     diff-switches " ")
  113.                "")))))
  114.  
  115. ;; not needed any longer, sk@sun4 21-May-1991 16:37
  116. ;; (defun vms-read-directory (dirname switches buffer)
  117. ;;   ;; Dired calls this function only in the current buffer
  118. ;;   ;; dired-ls gets redefined in dired-vms.el to work under VMS.
  119. ;;   (and buffer
  120. ;;        (not (eq buffer (current-buffer)))
  121. ;;        (error "Must be called in current buffer"))
  122. ;;   (dired-ls dirname switches nil t))
  123.  
  124. (defun member (x y)
  125.   "Like memq, but uses `equal' for comparison.
  126. This is a subr in Emacs 19."
  127.   (while (and y (not (equal x (car y))))
  128.     (setq y (cdr y)))
  129.   y)
  130.  
  131. (defun compiled-function-p (x)
  132.   "Emacs 18 doesn't have these."
  133.   nil)
  134.  
  135. ;; The 18.57 version has a bug that causes C-x C-v RET (which usually
  136. ;; re-visits the current buffer) to fail on dired buffers.
  137. ;; Only the last statement was changed to avoid killing the current
  138. ;; buffer.
  139. (defun find-alternate-file (filename)
  140.   "Find file FILENAME, select its buffer, kill previous buffer.
  141. If the current buffer now contains an empty file that you just visited
  142. \(presumably by mistake), use this command to visit the file you really want."
  143.   (interactive "FFind alternate file: ")
  144.   (and (buffer-modified-p)
  145.        (not buffer-read-only)
  146.        (not (yes-or-no-p (format "Buffer %s is modified; kill anyway? "
  147.                  (buffer-name))))
  148.        (error "Aborted"))
  149.   (let ((obuf (current-buffer))
  150.     (ofile buffer-file-name)
  151.     (oname (buffer-name)))
  152.     (rename-buffer " **lose**")
  153.     (setq buffer-file-name nil)
  154.     (unwind-protect
  155.     (progn
  156.       (unlock-buffer)
  157.       (find-file filename))
  158.       (cond ((eq obuf (current-buffer))
  159.          (setq buffer-file-name ofile)
  160.          (lock-buffer)
  161.          (rename-buffer oname))))
  162.     (or (eq (current-buffer) obuf)
  163.     (kill-buffer obuf))))
  164.  
  165. ;; At least in Emacs 18.55 this defvar has been forgotten to be copied
  166. ;; from lpr.el into loaddefs.el
  167.  
  168. (defvar lpr-command (if (eq system-type 'usg-unix-v)
  169.             "lp" "lpr")
  170.   "Shell command for printing a file")
  171.  
  172. ;; We need background.el (from Olin Shiver's comint release)
  173. ;; in Emacs 18 - only Emacs 19's shell command understands `&'.
  174.  
  175. ;; These contortions are necessary because Epoch also defines a
  176. ;; functions named `background', to set the background color of a
  177. ;; screen.  Why o why didn't they call it epoch::background?
  178.  
  179. (defun comint::background (command)
  180.   "Run COMMAND in the background like csh.  
  181. A message is displayed when the job starts and finishes.  The buffer is in
  182. comint mode, so you can send input and signals to the job.  The process object
  183. is returned if anyone cares.  See also comint-mode and the variables
  184. background-show and background-select."
  185.   (require 'background)
  186.   (background command))
  187.  
  188. (defun background-comint-or-epoch (&rest args)
  189.   "Dispatch functions that calls `comint::background' if called with
  190. one argument, `epoch::background' else.
  191. If called interactively, does `comint::background'."
  192.   (interactive "s%% ")
  193.   (apply (if (= (length args) 1)
  194.          (function comint::background)
  195.        (function epoch::background))
  196.      args))
  197.  
  198. (if (not (boundp 'epoch::version))
  199.     ;; Without Epoch there are no problems at all:  `comint::background'
  200.     ;; will simply use CMU background.el's version.
  201.     nil
  202.   ;; Else we're running Epoch.  Save its version of background before
  203.   ;; we try loading CMU background.el, maybe clobbering Epoch's version.
  204.   (or (fboundp 'epoch::background)    ; if this file is loaded twice
  205.       (fset 'epoch::background (symbol-function 'background)))
  206.   ;; Now both comint::background and epoch::background are suitably defined.
  207.   (if (not (or (featurep 'background)
  208.            (load "background" t 'silent)))
  209.       ;; If CMU's background.el is not avaiable, leave it at
  210.       ;; comint::background's default definition: the require will
  211.       ;; signal an error if actually called.  No need to abort now.
  212.       nil
  213.     ;; background.el is loaded by now: save CMU background for dired
  214.     (fset 'comint::background (symbol-function 'background))
  215.     ;; This used to
  216.     ;; restore Epoch's original definition, making background a subr again:
  217.     ;;- (fset 'background (symbol-function 'epoch::background))
  218.     ;; This is better, it even makes all those packages work that
  219.     ;; never new about the background confusion in Epoch (like
  220.     ;; cmutex's C-c P tex preview command, or dired-x11.el):
  221.     (fset 'background 'background-comint-or-epoch)))
  222.  
  223. (provide 'emacs-19)
  224.